Otherware/Otherware_1_SB_Development.iso/mac/developm/source/rclesrc.10/ircle sources/InputLine.p

Text File | 1992-09-06 | 8.6 KB | 428 lines

{    ircle - Internet Relay Chat client    }
{    File: InputLine    }
{    Copyright ⌐ 1992 Olaf Titz ([e-mail])    }

{    This program is free software; you can redistribute it and/or modify    }
{    it under the terms of the GNU General Public License as published by    }
{    the Free Software Foundation; either version 2 of the License, or    }
{    (at your option) any later version.    }

{    This program is distributed in the hope that it will be useful,    }
{    but WITHOUT ANY WARRANTY; without even the implied warranty of    }
{    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    }
{    GNU General Public License for more details.    }

{    You should have received a copy of the GNU General Public License    }
{    along with this program; if not, write to the Free Software    }
{    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.    }

unit InputLine;
{ Provides a small window with status and input lines. }
{ All keystrokes go into the input line. Implements a command history.}

interface
uses
    ApplBase;

procedure InitInputLine;
{ Startup }

procedure OpenInputLine (process: ProcPtr);
{ Open the input line window }
{ process(var s:string) gets called whenever Return was pressed }

procedure SetInputLine (var s: string);
{ Preset the input line }

procedure InsertInputLine (var s: string);
{ Insert a string into the input line }

procedure StatusLine (var s: string);
{ Set the status line }

procedure CloseInputLine;
{ Close the window }

implementation

const
    MAXHIST = 5000;    { Maximum # of chars to store in command history }
    MAXLINE = 240;        { Maximum length of input line }

var
    iw: WindowPtr;
    Hact, Hupd, Hmouse, Hkey, Hakey, Hidle, Hpaste: integer;
    status, line: string;
    procs: ProcPtr;
    line1, line2, letterw: integer;
    CursorRect: Rect;
    LeftMargin, Cursor: integer;
    blink: longint;
    bls, ReturnHit: boolean;
    hist: CharsHandle;
    hpos: integer;

procedure initInputLine;
    var
        i: integer;
    begin
        iw := nil;
        hist := CharsHandle(NewHandle(1));
        hist^^[0] := chr(0);
        hpos := 0;
    end;

procedure DoRedraw (l: integer);
    var
        p0: GrafPtr;
    begin
        GetPort(p0);
        SetPort(iw);
        if l = 1 then begin
            MoveTo(1, line1);
            DrawString(status);
        end
        else begin
            MoveTo(1, line2);
            DrawText(@line, LeftMargin + 1, 80);
        end;
        SetPort(p0);
    end;

procedure StackupLine;
    var
        i: integer;
    begin
        if gethandlesize(Handle(hist)) > MAXHIST then begin
            i := 1;
            while hist^^[i] <> chr(0) do
                i := succ(i);
            i := Munger(Handle(hist), 1, nil, i, ptr(1), 0);
        end;
        i := length(line) + 1;
        if i > 1 then begin
            line[i] := chr(0);
            i := PtrAndHand(@line[1], Handle(hist), i);
            hpos := gethandlesize(Handle(hist)) - 1;
        end
    end;

procedure RecallLine (p: integer);
    var
        i: integer;
        s: string;
    begin
        hpos := p;
        i := 0;
        repeat
            p := succ(p);
            i := succ(i);
            s[i] := hist^^[p];
        until s[i] = chr(0);
        s[0] := chr(i - 1);
        SetInputLine(s);
    end;

procedure RecallLineUp;
    var
        i: integer;
    begin
        i := hpos;
        if i > 0 then begin
            repeat
                i := pred(i)
            until hist^^[i] = chr(0);
            RecallLine(i);
        end
    end;

procedure RecallLineDown;
    var
        i: integer;
        s: string[1];
    begin
        i := hpos;
        if i < gethandlesize(handle(hist)) - 1 then begin
            repeat
                i := succ(i)
            until hist^^[i] = chr(0);
            if i < gethandlesize(handle(hist)) - 1 then
                RecallLine(i)
            else begin
                s := '';
                SetInputLine(s);
            end;
        end;
    end;


procedure SetCursor (n: integer);
    begin
        if n < 1 then
            n := 1
        else if n > MAXLINE then
            n := MAXLINE;
        if leftMargin > n - 1 then
            leftMargin := n - 1
        else if leftMargin < n - 81 then
            leftmargin := n - 81;
        EraseRect(CursorRect);
        Cursor := n;
        SetRect(CursorRect, (Cursor - LeftMargin - 1) * letterw, line1 + 3, (Cursor - LeftMargin - 1) * letterw + 1, line2 + 2);
        bls := true;
        blink := maxlongint;
        DoRedraw(2);
    end;


function Activate (var e: EventRecord): boolean;
    begin
        if iw <> nil then
            if bitand(e.message, 1) = 1 then
                ShowWindow(iw)
            else
                HideWindow(iw);
        Activate := false
    end;

function Update (var e: EventRecord): boolean;
    begin
        if WindowPtr(e.message) = iw then begin
            BeginUpdate(iw);
            MoveTo(1, line1);
            DrawString(status);
            MoveTo(1, line2);
            DrawText(@line, LeftMargin + 1, 80);
            EndUpdate(iw);
            Update := true
        end
        else
            Update := false
    end;

function Mouse (var e: EventRecord): boolean;
    begin
        if WindowPtr(e.message) = iw then begin
            GlobalToLocal(e.where);
            SetCursor(e.where.h div letterw + 1 + LeftMargin);
            Mouse := true
        end
        else
            Mouse := false
    end;

procedure SCALL (var s: string; p: ProcPtr);
inline
    $205F, $4E90;        { movea.l (a7)+,a0; jsr (a0) }

procedure GotLine;
    var
        i: integer;
    begin
        ReturnHit := true;
        i := 255;
        while (i > 0) and (line[i] = ' ') do
            i := pred(i);
        line[0] := chr(i);
        StackupLine;
        SCALL(line, procs);
        line := '';
        SetInputLine(line);
        ReturnHit := false;
    end;


function Key (var e: EventRecord): boolean;
    var
        c: char;
        i: integer;
        p0: GrafPtr;
    begin
        if iw = nil then
            Key := false
        else begin
            getPort(p0);
            SetPort(iw);
            c := chr(e.message mod 256);
            case ord(c) of
                8:
                    if cursor > 1 then begin
                        for i := cursor - 1 to MAXLINE - 1 do
                            line[i] := line[i + 1];
                        line[MAXLINE] := ' ';
                        SetCursor(pred(cursor));
                    end;
                13:
                    GotLine;
                28:
                    SetCursor(pred(cursor));
                29:
                    SetCursor(succ(cursor));
                30:
                    RecallLineUp;
                31:
                    RecallLineDown;
                otherwise
                    begin
                    if cursor < MAXLINE then begin
                        for i := MAXLINE downto cursor + 1 do
                            line[i] := line[i - 1];
                        line[cursor] := c;
                        SetCursor(succ(cursor));
                    end;
                end;
            end;
            SetPort(p0);
        end;
        Key := true;
    end;

function AKey (var e: EventRecord): boolean;
    begin
        AKey := Key(e)
    end;

function Idle (var e: EventRecord): boolean;
    var
        p0: GrafPtr;
    begin
        if abs(e.when - blink) > GetCaretTime then begin
            GetPort(p0);
            SetPort(iw);
            bls := not bls;
            blink := e.when;
            penMode(patXor);
            PaintRect(CursorRect);
            SetPort(p0);
        end;
        Idle := false;
    end;

function Paste (var e: EventRecord): boolean;
    var
        h: CharsHandle;
        i, n, c: integer;
        f: EventRecord;
        b: boolean;
    begin
        if e.message = 5 then begin
            i := TEFromScrap;
            h := CharsHandle(TEScrapHandle);
            n := TEGetScrapLen;
            for i := 0 to n - 1 do begin
                c := ord(h^^[i]);
                f.message := c;
                b := Key(f);
                if c = 13 then
                    repeat
                        ApplRun
                    until not ReturnHit;
            end;
            Paste := true
        end
        else
            Paste := false
    end;

procedure OpenInputLine (process: ProcPtr);
    var
        p0: GrafPtr;
        fi: FontInfo;
        r: Rect;
        i: integer;
    begin
        if iw = nil then begin
            for i := 1 to 255 do begin
                Status[i] := ' ';
                line[i] := ' '
            end;
            Status[0] := chr(255);
            line[0] := chr(255);
            LeftMargin := 0;
            SetRect(r, 0, 0, 16, 16);
            iw := NewWindow(nil, r, '', false, 3, WindowPtr(-1), false, 0);
            if iw <> nil then begin
                GetPort(p0);
                SetPort(iw);
                SetOrigin(-2, -2);
                penMode(patXor);
                TextFont(monaco);
                TextSize(9);
                TextFace([]);
                TextMode(srcCopy);
                GetFontInfo(fi);
                line1 := fi.ascent + fi.leading;
                line2 := line1 + fi.descent + fi.leading + fi.ascent + 1;
                SetRect(CursorRect, 0, 0, 0, 0);
                letterw := fi.widMax;
                blink := -maxlongint;
                bls := false;
                SizeWindow(iw, 80 * letterw + 4, line2 + fi.descent + fi.leading + 6, true);
                with screenBits.bounds do
                    MoveWindow(iw, (right - left - iw^.portRect.right + 2) div 2 - 1, bottom - iw^.portRect.bottom - 5, true);
                Hact := ApplTask(@Activate, app4Evt);
                Hupd := ApplTask(@Update, updateEvt);
                Hmouse := ApplTask(@Mouse, mouseMsg + inContent);
                Hkey := ApplTask(@Key, keyDown);
                Hakey := ApplTask(@Akey, autoKey);
                Hidle := ApplTask(@Idle, nullEvent);
                Hpaste := ApplTask(@Paste, menuMsg + editMenu);
                SetCursor(0);
                SetPort(p0);
                ShowWindow(iw);
                procs := process;
            end
        end;
    end;

procedure StatusLine (var s: string);
    begin
        status := s;
        DoRedraw(1);
    end;

procedure SetInputLine (var s: string);
    var
        i: integer;
        p0: GrafPtr;
    begin
        if iw <> nil then begin
            GetPort(p0);
            SetPort(iw);
            line := s;
            SetCursor(length(line) + 1);
            for i := length(line) + 1 to 255 do
                line[i] := ' ';
            line[0] := chr(255);
            DoRedraw(2);
            SetPort(p0)
        end
    end;


procedure InsertInputLine (var s: string);
    var
        i: integer;
        f: EventRecord;
        b: boolean;
    begin
        for i := 1 to length(s) do begin
            f.message := ord(s[i]);
            b := Key(f);
        end;
    end;

procedure CloseInputLine;
    begin
        ApplUntask(Hact);
        ApplUntask(Hupd);
        ApplUntask(Hmouse);
        ApplUntask(Hkey);
        ApplUntask(Hakey);
        ApplUntask(Hidle);
        ApplUNtask(Hpaste);
        DisposeWindow(iw);
        iw := nil
    end;

end.